Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue29/gmslabel/GMSLABEL.ZIP/GMSLABEL.PAS

Pascal/Delphi Source File | 1997-11-13 | 13.7 KB | 405 lines

{ GMSStickyLabel v1.4 Nov/12/97  by Glenn Shukster & Jacques Scoatarin

  GMS COMPUTING INC.                 Phone         [phone]
  53 COLVIN CRES.                    Fax                   -6819
  THORNHILL, ONT.                    Compuserve:       72734,123
  CANADA  L4J 2N7                    InternetId:[e-mail]
                                     http://members.tor.shaw.wave.ca/~gms/

  Jacques Scoatarin                  Phone         [phone]
  52 Athalassis Ave. (flat 202)
  Nicosia
  Cyprus                             InternetId:[e-mail]


Purpose:
  TLabel that will attach to any TWinControl Component on the
  form like TEdit, TDBMemo, TButton etc.  There are other
  components out there that make a label part of the edit or
  memo etc. but they tie you too much to that other component.

Features:
  1) All abilities of TLabel still exist
  2) Works with Delphi 1,2,3.
  3) _AlignTo: The position it will align to the TWinControl (left, right, top, bottom)
  4) _AttachTo: The TWincontrol this label will attach to.
  5) _Gap:     The space between the two components
  6) Right Click: Component editor option
           realigns all TGMSStickyLabels on the form(owner) to their _AttachTo components
  7) Drop Label on any TWinControl and it asks to fill in _AttachTo with that component
  8) Move TWinControl: the label will follow the _AttachTo component

Files:
  GMSLabel.pas : This component
  LblEdit.pas  : Component editor for GMSLabel
  GMSLabel.dcr : In the 16 directory for Delphi 1
  GMSLabel.dcr : In the 32 directory for Delphi 2 & 3

Installation:
  Copy the above pas files and the *.dcr file in the (16 Dir Delphi1)
  or (32 Dir Delphi 2 & 3) into one of the dirs in your component lib
  search path.  Then install gmslabel.pas & lbledit.pas.
  Only GMSStickyLabel will appear on your component pallet under GMS.

Copyright:
  This component is free if you keep this comment header.
  Any damage real or imagined caused by this component is
  100% your responsibility not GMS Computing Inc.'s.

Thank You
  This free component is my way of saying thank you to The Delphi Community.
  People have been more than helpful to me in the forums & newsgroups,
  especially team B members, Wayne Niddery, and Jacques Scoatarin.
  As an example of how great a community we have within a day of sending
  this component out Jacques Scoatarin basically added the lower level api
  calls to enable features 7 & 8 which make the component much more robust.
  Enjoy!

  If you like and use this component e-mail to let me know.
  P.S. GMS Computing Inc.(which is me) is always looking for new contracts.
  If you like what you see then contact me.  See my web page for more details.

VERSION INFO
GMSStickyLabel v1.1 July/5/97  by Glenn Shukster & Jacques Scoatarin
    - Released on public.
 V 1.2  Aug/14/97
    - Thanks to Erik B. Berry <[e-mail]> &
      Jean-Christophe Boggio <[e-mail]> who reported the
      behavior below
    - Corrected weird behavior that occured when the panel was aligned
      bottom and then you assign the TGMSStickylabel
    - Corrected if TGMSStickyLabel is moved from _AttachedTo component
      back to the same _AttachedTo component it would not realign itself.
      Now it does.
    - Corrected when selecting _AttachedTo you could select a component
      who did not have the same parent with poor results:  Added a
      property editor that only displays TWinControls that have the same parent.
 V 1.3 Sep/22/97
    - Thanks to Gerald  [e-mail] for reporting the following bug
    - Bug in only Delphi3 version.  When there is something aligned to top and
      a new TGMSStickyLabel is dropped on a component it will loop through all the
      components 3 times with the RectBounds of the TGMSStickyLabel being incorrect
      until the last loop.   In Delphi2 & 1 it only goes thought the loop once with
      the correct co-ordinates.
      Solution was that only attach if (Self.BoundsRect.Top > 0)
      This is a trade off for if you ever try to drop a component at position 0 it will
      not attach.  Drop it just a bit below 0 and it will align no problem.
    - Thanks to Erik B. Berry <[e-mail]> for the below improvement
      Eric suggested to have the component alignment be laRightJustify if the _AlignTo
      is alLeft.  This way when editing the caption it will grow away from the control
      its attached to, thus not asking to attach to it again.
 V 1.4 Nov/12/97
    - Added options the following options to the property editor
      alignment (right, left, top, bottom), Set gap, Edit Caption
}

unit GMSLabel;

{$D-} { Turns debugger off  comment this line out if you want to step through it}

interface

uses
  Classes,
  StdCtrls,
  Controls,
  Messages,
  Forms,
  Dialogs,
  DsgnIntf,
{$IFDEF WIN32}
  SysUtils, { for writing to file for debugging purposes}
  Windows
{$ELSE}
  WinProcs, WinTypes
{$ENDIF}
;

type
  TAlignTo = (alLeft, alTop, alBottom,  alRight);
  TGMSStickyLabel = class(TLabel)
  private
    FAttachTo: TWinControl;
    FAlignTo: TAlignTo;
    FGap : Integer;
    FDefAttachedProc: Pointer;
    FAttachedInstance: Pointer;
    FRealigning: Boolean;
    Procedure SetGap(Value: Integer);
    procedure SetAttachTo(Value: TWinControl);
    Procedure SetAlignTo(Value: TAlignTo);
    { New Attached controls WndProc }
    procedure AttachedWndProc(var Message: TMessage);
    { Procedure ErrFile(sString: String);}
  protected
    procedure CheckForControl;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetParent(AParent: TWinControl); override;
    { Override WndProc }
    procedure WndProc(var Message: TMessage); override;
  public
    Procedure _ReAlign;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property _AlignTo: TAlignTo read FAlignTo write SetAlignTo default alLeft;
    property _AttachTo: TWinControl read FAttachTo write SetAttachTo;
    Property _Gap : Integer Read FGap write SetGap Default 5;
  end;

procedure Register;

implementation

constructor TGMSStickyLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FGap := 5;
  FRealigning := False;
  { Make Instance out of method }
  FAttachedInstance := MakeObjectInstance(AttachedWndProc);
end;

destructor TGMSStickyLabel.Destroy;
begin
  { Restore original Attach Control WndProc }
  {   IsWindow check may be uneccessary but doesn't hurt ti be 100% sure }
  if Assigned(FAttachTo) and IsWindow(FAttachTo.Handle) then
    SetWindowLong(FAttachTo.Handle, GWL_WNDPROC, Longint(FDefAttachedProc));
  { Make method Instance }
  FreeObjectInstance(FAttachedInstance);
  inherited Destroy;
end;

procedure TGMSStickyLabel.AttachedWndProc(var Message: TMessage);
begin
  with Message do
  begin
    case Msg of
      { On Move/Size message call _ReAlign to keep us aligned! }
      WM_MOVE, WM_SIZE : _ReAlign;
    end;
    Result := CallWindowProc(FDefAttachedProc, FAttachTo.Handle, Msg, WParam, LParam);
  end;
end;

procedure TGMSStickyLabel.CheckForControl;
var
  I: Integer;
  RCDest: TRect;
begin
  { if - for not checking if already attached ? }
  { if not Assigned(FAttachTo) then }
  with Owner do
  begin
    for I := 1 to ComponentCount do
    if (Components[I - 1] is TWinControl) and (Components[I - 1] <> Self) then
    with Components[I - 1] as TWinControl do
    if (Parent = Self.Parent) then
    begin
      {
      ErrFile('Name:'+Name +'  Parent:'+ Parent.Name+ ' Self:'+Self.Name+#13 +
                 'Self.BoundsRect.Top   '+IntToStr(Self.BoundsRect.Top)+ #13 +
                 'Self.BoundsRect.Left   '+IntToStr(Self.BoundsRect.Left)+ #13 +
                 'Self.BoundsRect.Bottom'+IntToStr(Self.BoundsRect.Bottom)+ #13 +
                 'BoundsRect.Top'+IntToStr(BoundsRect.Top) + #13 +
                 'BoundsRect.Left'+IntToStr(BoundsRect.Left) + #13 +
                 'BoundsRect.Bottom'+IntToStr(BoundsRect.Bottom)
                 );
                 }
      If (Self.BoundsRect.Top > 0) Then
        begin
          IntersectRect(RCDest, Self.BoundsRect, BoundsRect);
          if not IsRectEmpty(RCDest) then
          begin
            {ErrFile('Asked to attach to '+Name+#13+#13);}
            if MessageDlg('Attach label to ' + Name, mtConfirmation, [mbYes, mbNo], 0) = mrYes then
            begin
              _AttachTo := Owner.Components[I - 1] as TWinControl;
              FocusControl := Owner.Components[I - 1] as TWinControl;
            end;
            break;
          end;
        end;
    end;
  end;
end;

procedure TGMSStickyLabel.SetParent(AParent: TWinControl);
var
  FOrigParent: TWinControl;
begin
  FOrigParent := Parent;
  inherited SetParent(AParent);
  if (Parent <> Nil) and not Assigned(FOrigParent) then
    CheckForControl;
end;

procedure TGMSStickyLabel.Notification(AComponent: TComponent; Operation: TOperation);
begin
  { dont forget to check if indeed it is FAttachTo that is being removed }
  if (Operation = opRemove) and (AComponent = FAttachTo) then
    FAttachTo := Nil;
  inherited Notification(AComponent,Operation);
end;

procedure TGMSStickyLabel.WndProc(var Message: TMessage);
begin
  with Message do
  begin
    case Msg of
      { On change of position check for controls to attach to }
      WM_WINDOWPOSCHANGED:
        if (not FRealigning) and (csDesigning in ComponentState) then
          CheckForControl;
    end;
  end;
  inherited WndProc(Message);
end;

procedure TGMSStickyLabel.SetAttachTo(Value: TWinControl);
begin
  if (FAttachTo <> Value) then
  begin
    { Restore original previously Attach Control WndProc }
    {   IsWindow check may be uneccessary but doesn't hurt to be 100% sure }
    If (Assigned(FAttachTo)= False) or (Assigned(FAttachTo) and (Value.Parent = Self.Parent)) Then {gms}
      begin
        if Assigned(FAttachTo) and IsWindow(FAttachTo.Handle) then
           SetWindowLong(FAttachTo.Handle, GWL_WNDPROC, Longint(FDefAttachedProc));
        FAttachTo := Value;
        if Assigned(FAttachTo) and IsWindow(FAttachTo.Handle) then
        begin
          { Get original Attach Control WndProc }
          FDefAttachedProc := Pointer(GetWindowLong(FAttachTo.Handle, GWL_WNDPROC));
          { Set the new Attach Control WndProc - our own method! }
          SetWindowLong(FAttachTo.Handle, GWL_WNDPROC, Longint(FAttachedInstance));
          _ReAlign;
        end;
      end
    else
      if (Assigned(FAttachTo) and (Value.Parent <> Self.Parent)) Then
         ShowMessage('Must have the same parents '+ #13#10 +
                     'AttachTo Parent is '+ TControl(Value.Parent).Name + #13#10 +
                     'TGMSStickyLabel Parent is '+ TControl(Self.Parent).Name);
  end
 else
   _ReAlign; { GMS if assigned back to the same component it will realign itself}
end;

Procedure TGMSStickyLabel.SetAlignTo(Value: TAlignTo);
begin
 If (FAlignTo <> Value) then
    begin
      FAlignTo := Value;
      _ReAlign;
    end ;
end;

Procedure TGMSStickyLabel.SetGap(Value: Integer);
begin
  If (FGap <> Value) Then
    begin
      FGap := Value;
      _ReAlign;
    end;
end;

Procedure TGMSStickyLabel._ReAlign;
var
  iNewTop, iNewLeft: Integer;
begin
  iNewTop := 0;  { to get rid of warnings}
  iNewLeft := 0; { to get rid of warnings}
  FRealigning := True;
  If FAttachTo <> Nil then
  begin
    Case FAlignTo of
       alLeft:
         begin
          iNewTop :=  FAttachTo.Top;
          iNewLeft := FAttachTo.Left - Width - FGap ;
          Alignment := taRightJustify;
         end ;
       alRight:
         begin
          iNewTop := FAttachTo.Top;
          iNewLeft := FAttachTo.Left + FAttachTo.Width + FGap ;
          Alignment := taLeftJustify;
         end ;
       alTop:
         begin
          iNewTop := FAttachTo.Top - Height - FGap ;
          iNewLeft := FAttachTo.Left ;
          Alignment := taLeftJustify;
         end;
       alBottom:
         begin
          iNewTop := FAttachTo.Top + FAttachTo.Height + FGap ;
          iNewLeft := FAttachTo.Left ;
          Alignment := taLeftJustify;
         end;
    end;
    { Set all propertied in one call to avoid multiple re-drawing & pos changes }
    SetBounds(iNewLeft, iNewTop, Width, Height);
  end;
  FRealigning := False;
end;

(*
Procedure TGMSStickyLabel.ErrFile(sString: String);
const
  cFileName = 'c:\Event.txt';
var
  FLog: TextFile;
begin
  AssignFile(FLog, cFileName);
  if FILEEXISTS(cFileName) Then
     Append(FLog)
  else
     ReWrite(FLog);
  Writeln(FLog,sString);
  CloseFile(FLog); {Close file, save changes}
end;
  *)


{PROPERTY EDITOR}
type
    TAttachToEditor = class(TComponentProperty)
    public
      procedure GetValues(Proc: TGetStrProc); override;
    end;

procedure TAttachToEditor.GetValues(Proc: TGetStrProc);
var
  II: Integer;
  Values: TStringList;
  oGMSStickyLabel : TGMSStickyLabel;
  P,P1 : TWinControl;
begin
  Values := TStringList.Create;
  try
    oGMSStickyLabel := GetComponent(0) as TGMSStickyLabel;
    P := oGMSStickyLabel.Parent;
    for II := 0 to P.ControlCount-1 do begin
      P1 := TWinControl(P.Controls[II]);
      if (P1 is TWinControl)
        and ((P.Controls[ii] is TGMSStickyLabel) = False)
        and (P1.Name <> '') then
          Values.Add(P1.Name);
    end;
    for II := 0 to Values.Count - 1 do Proc(Values[II]);
  finally
    Values.Free;
  end;
end;

procedure Register;
begin
  RegisterComponents('GMS', [TGMSStickyLabel]);
  RegisterPropertyEditor(TypeInfo(TWinControl),TGMSStickyLabel,'_AttachTo',TAttachToEditor);
end;

end.